home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
eulisp
/
feel-075.lha
/
feel0.75
/
AddOns
/
linkins.c
< prev
next >
Wrap
C/C++ Source or Header
|
1992-06-08
|
3KB
|
154 lines
/* ******************************************************************** */
/* init_elvira.c Copyright (C) Codemist and University of Bath 1989 */
/* */
/* Interpreter elvira. */
/* ******************************************************************** */
/*
* Change Log:
* Version 1, August 1990
*/
/* No Elvira as yet... */
#include <irun.h>
#include "allocate.h"
#include "garbage.h"
#include "error.h"
#define FRAMEBUG(x)
LispObject dlp;
LispObject elvira_slowcall_object;
LispObject Slowcall(LispObject i1)
{
LispObject res;
if (elvira_slowcall_object == nil)
CallError("slowcall: object to call unknown",i1,NONCONTINUABLE);
res = module_mv_apply_1(elvira_slowcall_object,i1);
elvira_slowcall_object = NULL;
return(res);
}
LispObject allocate_e_function(LispObject mod,LispObject (*fun)(),int args)
{
LispObject f;
FRAMEBUG(printf("Grabbing function object %d\n",args); fflush(stdout);)
f = allocate_module_function(mod,nil,fun,args);
f->OBJECT.type = TYPE_E_FUNCTION;
if (dp != nil) {
if (FRAME_TYPE(dp) == nil) { /* Copy it to the heap */
LispObject temp;
int i;
STACK(f); STACK(dp);
temp = (LispObject) allocate_vector(dp->VECTOR.length);
UNSTACK(2);
for (i = dp->VECTOR.length-1; i > 0; --i)
VREF(temp,i) = VREF(dp,i);
VREF(temp,0) = lisptrue; /* Heap frame */
dlp = dp = temp;
}
}
f->C_FUNCTION.env = (Env) dp; /* Right? */
FRAMEBUG(printf("Grabbed function object %d\n",args); fflush(stdout);)
return(f);
}
void init_stack_frame(LispObject frame,int n)
{
int i;
FRAMEBUG(printf("Initialising stack frame %d\n",n); fflush(stdout);)
frame->VECTOR.type = TYPE_VECTOR;
frame->VECTOR.gc = -1;
frame->VECTOR.class = Vector;
frame->VECTOR.next = NULL;
frame->VECTOR.length = n+2;
FRAME_TYPE(frame) = nil; /* Stack frame */
LAST_FRAME(frame) = nil;
for (i=0; i<n; ++i) VREF(frame,i+2) = nil;
FRAMEBUG(printf("Initialised stack frame %d\n",n); fflush(stdout);)
}
LispObject allocate_e_macro(LispObject mod,LispObject (*fun)(),int args)
{
LispObject f;
f = allocate_module_function(mod,nil,fun,args);
f->OBJECT.type = TYPE_E_MACRO;
f->C_FUNCTION.env = (Env) dp; /* Right? */
return(f);
}
LispObject *dynamic_ref(LispObject name)
{
Env ee = DYNAMIC_ENV();
while (ee != NULL)
if (ee->variable == name)
return(&(ee->value));
else
ee = ee->next;
if (name->SYMBOL.gvalue != NULL)
return(&(name->SYMBOL.gvalue));
else
CallError("dynamic: name unbound",name,NONCONTINUABLE);
return(&nil);
}
LispObject dynamic_setq(LispObject name,LispObject value)
{
Env ee = DYNAMIC_ENV();
while (ee != NULL)
if (ee->variable == name)
return(ee->value = value);
else
ee = ee->next;
if (name->SYMBOL.gvalue != NULL)
return(name->SYMBOL.gvalue = value);
else
CallError("dynamic-setq: name unbound",name,NONCONTINUABLE);
return(nil);
}
void initialise_elvira_modules()
{
extern void initialise_YY();
dp = nil;
INIT_YY();
}